Power Tools for Macintosh/Power Tools for Macintosh (SoftBit)(1992).iso/Stacks/*F-I/HyperCard Utilities/Videodisc⁄Drivers ƒ/PioneerLDV6000.p

Text File | 1987-01-31 | 6.2 KB | 269 lines | [TEXT/MPS ]

{$R-}
{$D+}
(*
    Pioneer-LD-V6000 -- a WildCard user-defined command to drive a laser disc player.

    To compile and link this file using Macintosh Programmer's Workshop,

    pascal PioneerLDV6000.p
    link -o WildCommands -sn Main=PioneerLDV6000 -sn STDIO=PioneerLDV6000 ∂
         -sn INTENV=PioneerLDV6000 -rt WCMD=4 ∂
         PioneerLDV6000.p.o {MPW}libraries:interface.o

    then use ResEdit to copy the resulting WCMD from WildCommands
    and paste it into WildCard, the Home stack, or your own stack.
    (WCMD=1 Panasonic, =2 Hitachi, =3 Phillips, =4 PioneerLDV6000)
*)

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf;

IMPLEMENTATION

PROCEDURE Pioneer(commandPtr: Ptr);                                        FORWARD;

   PROCEDURE EntryPoint(arg: Ptr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     Pioneer(arg);
   END;

   PROCEDURE Pioneer(commandPtr: Ptr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
       message: Str255;
       refNum: INTEGER;
       err: INTEGER;

     PROCEDURE OpenSerial;
     VAR handShake: SerShk;
         baudRate: INTEGER;
     BEGIN
       baudRate := 9600;
       { for now, use modem port so we don't mess with AppleTalk }
       err := FSOpen('.AOUT',0,refNum);
       IF err = 0 THEN
         BEGIN
           WITH handShake DO
             BEGIN
               fXon := 1;
               fCTS := 1;
               xon  := CHR(17);
               xoff := CHR(19);
               errs := 0;
               evts := 0;
               fInx := 0;
             END;
           err := SerHShake(refNum,handShake);
           IF err = 0 THEN
             err := Control(refNum,13,@baudRate);
         END;
     END;


     PROCEDURE CloseSerial;
     BEGIN
       err := FSClose(refNum);
     END;


     PROCEDURE SendCommand(cmd: Str255);
     VAR count: LongInt;
     BEGIN
       count := Length(cmd);
       err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
     END;

     FUNCTION Concat(str1, str2, str3: Str255): Str255;
     VAR result: Str255;
         resultLen: INTEGER;
         charNum: INTEGER;
     BEGIN
       result := '';
       resultLen := 0;
       FOR charNum := 1 TO Length(str1) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str1[charNum];
         END;
       FOR charNum := 1 TO Length(str2) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str2[charNum];
         END;
       FOR charNum := 1 TO Length(str3) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str3[charNum];
         END;
      result[0] := CHR(resultLen);
      Concat := result;
     END;


     PROCEDURE GetMessage;
     VAR charNum: INTEGER;
         msgChar: CHAR;
     BEGIN
       { skip command name }
       WHILE (commandPtr^ <> 0) AND (commandPtr^ <> 13) AND (CHR(commandPtr^) <> ' ') DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { skip following white space }
       WHILE CHR(commandPtr^) = ' ' DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { extract the rest into a Str255 }
       charNum := 0;
       WHILE (commandPtr^ <> 0) AND (charNum < 255) DO
         BEGIN
           msgChar := CHR(commandPtr^);
           commandPtr := Pointer(Ord(commandPtr)+1);
           charNum := charNum + 1;
           IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
             message[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')))
           ELSE message[charNum] := msgChar;
         END;
       message[0] := CHR(charNum);
     END;


     FUNCTION Contains(target: Str255): BOOLEAN;
     VAR offset: INTEGER;

       FUNCTION Match: BOOLEAN;
       VAR index: INTEGER;
       BEGIN
         Match := TRUE;
         FOR index := 1 TO Length(target) DO
           IF offset + index > Length(message) THEN
             BEGIN
               Match := FALSE;  { ran off the end }
               EXIT(Match);
             END
           ELSE IF target[index] <> message[offset+index] THEN
             BEGIN
               Match := FALSE;  { hit a wrong char }
               EXIT(Match);
             END;
       END;

     BEGIN
       Contains := FALSE;
       FOR offset := 0 TO Length(message) - 1 DO
         IF Match THEN
           BEGIN
             Contains := TRUE;
             EXIT(Contains);
           END;
     END;


     FUNCTION GetDigit(digit: CHAR): Str255;
     BEGIN
       CASE digit OF
         '0': GetDigit := '3F';
         '1': GetDigit := '0F';
         '2': GetDigit := '8F';
         '3': GetDigit := '4F';
         '4': GetDigit := '2F';
         '5': GetDigit := 'AF';
         '6': GetDigit := '6F';
         '7': GetDigit := '1F';
         '8': GetDigit := '9F';
         '9': GetDigit := '5F';
       END;
     END;


     FUNCTION GetInteger: Str255;
     { get an integer in Pioneer format }
     VAR digitLoc, charVal: INTEGER;
         intStr: Str255;
     BEGIN
       intStr := '';
       FOR digitLoc := 1 TO Length(message) DO
         BEGIN
           charVal := ORD(message[digitLoc]);
           IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
             intStr := Concat(intStr, GetDigit(message[digitLoc]), '');
         END;
       GetInteger := intStr;
     END;

   BEGIN
     OpenSerial;
     IF err <> 0 THEN
       BEGIN
         SysBeep(1);
         EXIT(Pioneer);
       END;

     GetMessage;

     { set flags }
     reverseFlag := Contains('rev');
     offFlag := Contains('off');
     tillFlag := Contains('till');

     IF Contains('stop') THEN SendCommand('@FB')
     ELSE IF Contains('eject') THEN SendCommand('@F9')
     ELSE IF Contains('search') THEN SendCommand(Concat('@', GetInteger, 'F7'))
     ELSE IF Contains('step') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('@FE')
         ELSE SendCommand('@F6')
       END
     ELSE IF Contains('play') THEN
       BEGIN
         IF tillFlag THEN SendCommand(Concat('@', GetInteger, 'F3'))
         ELSE IF reverseFlag THEN SendCommand('@0FECFA')
         ELSE SendCommand('@FD')
       END
     ELSE IF Contains('slow') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('@4FEDFA')
         ELSE SendCommand('@4FEDF2')
       END
     ELSE IF Contains('fast') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('@4FECFA')
         ELSE SendCommand('@4FECF2')
       END
     ELSE IF Contains('scan') THEN
       BEGIN
         IF reverseFlag THEN SendCommand('@4FECFA')
         ELSE SendCommand('@4FECF2')
       END
     ELSE IF Contains('picture') THEN
       BEGIN
         IF offFlag THEN SendCommand('@1C')
         ELSE SendCommand('@1B')
       END
     ELSE IF Contains('frame') THEN
       BEGIN
         IF offFlag THEN SendCommand('@3FF1')
         ELSE SendCommand('@0FF1')
       END
     ELSE IF Contains('sound') THEN
       BEGIN
         IF Contains('1') THEN
           IF offFlag THEN SendCommand('@3FF4')
           ELSE SendCommand('@0FF4')
         ELSE IF Contains('2') THEN
           IF offFlag THEN SendCommand('@3FFC')
           ELSE SendCommand('@0FFC')
         ELSE SysBeep(1);
       END
     ELSE IF NOT Contains('init') THEN { init does nothing for this player }
        SysBeep(1); { unknown command }
     CloseSerial;
   END;

END.